# Встановлення та підключення пакетів, якщо вони ще не встановлені
if (!require(DBI)) install.packages("DBI")
if (!require(RSQLite)) install.packages("RSQLite")
if (!require(dplyr)) install.packages("dplyr")
if (!require(randomForest)) install.packages("randomForest", repos = "https://cloud.r-project.org/")
if (!require(knitr)) install.packages("knitr")
if (!require(GGally)) install.packages("GGally")
if (!require(caret)) install.packages("caret", repos = "https://cloud.r-project.org/")

# Підключення бібліотек
library(DBI)
library(RSQLite)
library(dplyr)
library(knitr)
library(randomForest)
library(GGally)
library(caret)

Виконання індивідуального завдання: оцінка популярності водіїв

Отримання даних

# Вказання шляху до бази даних SQLite
sqlite_db_path <- "driver_popularity.db"

# Підключення до SQLite для використання збережених даних
sqlite_conn <- dbConnect(SQLite(), dbname = sqlite_db_path)

# Отримання даних з таблиці driver_popularity в SQLite
driver_data <- dbGetQuery(sqlite_conn, "SELECT * FROM driver_popularity WHERE completed_orders > 0")

# Закриття з'єднання
dbDisconnect(sqlite_conn)

# Перегляд перших рядків даних
head(driver_data)
##   driver_id completed_orders canceled_orders proposals_created total_earnings
## 1         1               61              47               518      1409.4559
## 2         6              225              52              1433      1766.8871
## 3        50              883             116              8463      7494.3635
## 4        63              721              48              1867      6979.3543
## 5       143              308              42               886      1464.3243
## 6       155               52               4              1049       471.1283

Генерація тестового проекту, створення моделей та їх оценка

# Перевірка кореляцій між змінними
driver_data %>%
  select(completed_orders, canceled_orders, proposals_created, total_earnings) %>% 
  cor() %>%
  knitr::kable(caption = "Таблиця коефіцієнтів кореляції")
Таблиця коефіцієнтів кореляції
completed_orders canceled_orders proposals_created total_earnings
completed_orders 1.0000000 0.8953766 0.627939 0.9548721
canceled_orders 0.8953766 1.0000000 0.671784 0.9117306
proposals_created 0.6279390 0.6717840 1.000000 0.7030130
total_earnings 0.9548721 0.9117306 0.703013 1.0000000 
driver_data %>%
  select(completed_orders, canceled_orders, proposals_created, total_earnings) %>% 
ggpairs()

Побудова базової моделі лінійної регресії

# Побудова регресійної моделі
model <- lm(total_earnings ~ completed_orders + canceled_orders + proposals_created, data = driver_data)

# Перегляд результатів моделі
summary(model)
## 
## Call:
## lm(formula = total_earnings ~ completed_orders + canceled_orders + 
##     proposals_created, data = driver_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -12808.4   -117.6    -64.5     41.2  31570.7 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       67.664592  20.239917   3.343 0.000836 ***
## completed_orders   3.934676   0.051977  75.701  < 2e-16 ***
## canceled_orders   19.536780   0.865959  22.561  < 2e-16 ***
## proposals_created  0.131306   0.005372  24.441  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1145 on 3917 degrees of freedom
## Multiple R-squared:  0.9376, Adjusted R-squared:  0.9375 
## F-statistic: 1.96e+04 on 3 and 3917 DF,  p-value: < 2.2e-16
plot(model)

Виключаємо викиди та повторно здійснюємо побудову моделі регресії.

driver_data_filter = driver_data %>%
  filter(!row_number() %in% c(1654, 3157))

model <- lm(total_earnings ~ completed_orders + canceled_orders + proposals_created, data = driver_data_filter)

# Перегляд результатів моделі
summary(model)
## 
## Call:
## lm(formula = total_earnings ~ completed_orders + canceled_orders + 
##     proposals_created, data = driver_data_filter)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11576.5   -107.8    -54.0     50.5  14089.5 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       57.016007  17.866447   3.191  0.00143 ** 
## completed_orders   3.989780   0.047337  84.284  < 2e-16 ***
## canceled_orders   19.208200   0.831920  23.089  < 2e-16 ***
## proposals_created  0.130356   0.004786  27.234  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1007 on 3915 degrees of freedom
## Multiple R-squared:  0.9494, Adjusted R-squared:  0.9493 
## F-statistic: 2.447e+04 on 3 and 3915 DF,  p-value: < 2.2e-16
plot(model)

Скористаємося покроковою процедурою включення з вилученням слабких предикторів

model <- lm(total_earnings ~ completed_orders, data = driver_data_filter)

modelStep <- step(model, trace = 0)
summary(modelStep)
## 
## Call:
## lm(formula = total_earnings ~ completed_orders, data = driver_data_filter)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10196.7   -300.7   -246.8      0.3  20376.1 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      305.87671   20.74101   14.75   <2e-16 ***
## completed_orders   5.51728    0.02526  218.41   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1233 on 3917 degrees of freedom
## Multiple R-squared:  0.9241, Adjusted R-squared:  0.9241 
## F-statistic: 4.77e+04 on 1 and 3917 DF,  p-value: < 2.2e-16
anova(model, modelStep)
## Analysis of Variance Table
## 
## Model 1: total_earnings ~ completed_orders
## Model 2: total_earnings ~ completed_orders
##   Res.Df        RSS Df Sum of Sq F Pr(>F)
## 1   3917 5955106744                      
## 2   3917 5955106744  0         0

Виконаємо тестування двох моделей з використанням десятикратної перехресної перевірки (cross validation).

modelTrain = train(total_earnings ~ completed_orders + canceled_orders + proposals_created, 
                   data = driver_data_filter, 
                   method = 'lm', 
                   trainControl = trainControl(method = "cv")
                   )

modelTrainStep <- train(total_earnings ~ completed_orders, 
                        data = driver_data_filter, 
                        method = 'lm', 
                        trainControl = trainControl(method = "cv")
                        )

modelTrain
## Linear Regression 
## 
## 3919 samples
##    3 predictor
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 3919, 3919, 3919, 3919, 3919, 3919, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   995.0842  0.9497977  392.0482
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE
modelTrainStep
## Linear Regression 
## 
## 3919 samples
##    1 predictor
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 3919, 3919, 3919, 3919, 3919, 3919, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   1236.603  0.9242523  553.6888
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

Цю модель можна покращити, вилучивши константу зі специфікації моделі

modelForCompleted <- lm(total_earnings ~ completed_orders - 1, data = driver_data_filter)
summary(modelForCompleted)
## 
## Call:
## lm(formula = total_earnings ~ completed_orders - 1, data = driver_data_filter)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11304.2      4.4     56.3    290.1  20279.5 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## completed_orders  5.63404    0.02464   228.6   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1267 on 3918 degrees of freedom
## Multiple R-squared:  0.9303, Adjusted R-squared:  0.9303 
## F-statistic: 5.227e+04 on 1 and 3918 DF,  p-value: < 2.2e-16
plot(modelForCompleted)

ggplot(driver_data_filter,
       aes(x = completed_orders - 1, y = total_earnings,
           colour = canceled_orders)) +
  labs(title = "Залежність заробітку від кількості виконаних замовлень",
       subtitle = "Лінійна регресія з 95% довірчими межами",
       caption = "Без коригування. Кольором виділено кількість відхиленних замовлень", 
       x = "Кількість виконаних замовлень", y = "Дохід") +
  geom_point() +
  stat_smooth(method=lm, se = TRUE, fullrange = TRUE)

Виходячи з правила “трьох сигм,” для коригування лінійної моделі доцільно видалення ще двох точок

dataFilterThreeSigma = driver_data %>%
  filter(!row_number() %in% c(259, 223, 1654, 3157))

lmByThreeSigma <- lm(total_earnings ~ completed_orders - 1, data = dataFilterThreeSigma)

summary(lmByThreeSigma)
## 
## Call:
## lm(formula = total_earnings ~ completed_orders - 1, data = dataFilterThreeSigma)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10794.4      4.8     56.9    296.6  14618.9 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## completed_orders  5.59192    0.02342   238.8   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1199 on 3916 degrees of freedom
## Multiple R-squared:  0.9357, Adjusted R-squared:  0.9357 
## F-statistic: 5.701e+04 on 1 and 3916 DF,  p-value: < 2.2e-16
plot(lmByThreeSigma)

ggplot(dataFilterThreeSigma,
       aes(x = completed_orders - 1, y = total_earnings,
           colour = canceled_orders)) +
  labs(title = "Залежність заробітку від кількості виконаних замовлень",
       subtitle = "Лінійна регресія з 95% довірчими межами",
       caption = "З коригуванням. Кольором виділено кількість відхиленних замовлень", 
       x = "Кількість виконаних замовлень", y = "Дохід") +
  geom_point() +
  stat_smooth(method=lm, se = TRUE, fullrange = TRUE)

Точковий та інтервальний прогноз охоплення аудиторії

completedNumber <- data.frame(completed_orders=c(200, 400, 800, 850))
pre <- predict(lmByThreeSigma, completedNumber, interval="confidence")
knitr::kable(cbind(completedNumber, pre),
             caption = "Точковий та інтервальний прогноз охоплення аудиторії")
Точковий та інтервальний прогноз охоплення аудиторії
completed_orders fit lwr upr
200 1118.385 1109.202 1127.568
400 2236.770 2218.403 2255.136
800 4473.539 4436.807 4510.272
850 4753.135 4714.107 4792.164